(COMMENT GENERALLY USEFUL LISP MACROS)

(DEFPROP DFUNC
 (LAMBDA (L)
  (LIST (Q DEFPROP) (CAADR L) (MCONS (Q LAMBDA) (CDADR L) (CDDR L)) (Q EXPR)))
 MACRO)

(DEFPROP MAPDEF
 (LAMBDA (L)
  (LIST	(Q MAPCAR)
	(SUBST (CADR L)
	       (Q IND)
	       (Q (FUNCTION (LAMBDA (PAIR)
			     (PUTPROP (CAR PAIR) (CADR PAIR) (QUOTE IND))))))
	(LIST (Q QUOTE) (CDDR L))))
 MACRO)

(DEFPROP MCONS
	 (LAMBDA (L)
		 (COND ((NULL (CDDR L)) (CADR L))
		       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L))))))
	 MACRO)

(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO)

(COMMENT END OF GENERAL LISP MACROS)

(COMMENT PROPERTY TABLE PRIMITIVES)

(DEFPROP FIRSTPROP (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP LASTPROP (LAMBDA (L) (CONS (Q NULL) (CDR L))) MACRO)

(DEFPROP NEXTPROP (LAMBDA (L) (CONS (Q CDDR) (CDR L))) MACRO)

(DEFPROP PROPFLAG (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP PROPTABLE (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP PROPVAL (LAMBDA (L) (CONS (Q CADR) (CDR L))) MACRO)

(DFUNC (DELETEPROP IDENT FLAG)
       (PROG (TEM)
	     (SETQ TEM IDENT)
	LOOP (COND ((NULL (CDR TEM)) (RETURN NIL)))
	     (COND ((EQ (CADR TEM) FLAG) (RPLACD TEM (CDDDR TEM)) (RETURN T)))
	     (SETQ TEM (CDDR TEM))
	     (GO LOOP)))

(DFUNC (GETGET ATOM PROP)
       (PROG (TEM PTAB)
	     (SETQ PTAB (FIRSTPROP ATOM))
	LOOP (COND ((LASTPROP PTAB) (RETURN NIL)))
	     (COND ((SETQ TEM (SEEKPROP (PROPFLAG PTAB) PROP)) (RETURN TEM)))
	     (SETQ PTAB (NEXTPROP PTAB))
	     (GO LOOP)))

(DFUNC (INITPROP IDENT FLAG VAL) (RPLACD IDENT (MCONS FLAG VAL (CDR IDENT))))

(DFUNC (SEEKPROP IDENT PROP) (GETL IDENT (LIST PROP)))

(DFUNC (SETPROP IDENT FLAG VAL) (PUTPROP IDENT VAL FLAG))

(COMMENT END OF PROPERTY TABLE PRIMITIVES)

(DECLARE (SPECIAL LINCNT PAGEHEIGHT PAGEWIDTH LAPINDENT OUTEXT *SP *TB *CR *LF
		  *VT *FF *CO *PT *LP *RP *SL *AM *RO *AT *LB *RB)
	 (DEFPROP DATAERR T *FSUBR))

(COMMENT FORMAT PROGRAM MACROS)

(DEFPROP ATLEFT (LAMBDA (L) (LIST (Q EQ) 1 (Q (CURCOL)))) MACRO)

(DEFPROP ATTOP (LAMBDA (L) (LIST (Q EQ) (Q LINCNT) 1)) MACRO)

(DEFPROP CLEANPLATE (LAMBDA (L) (LIST (Q LIST) 0 1 0 NIL)) MACRO)

(DEFPROP COLLOC (LAMBDA (L) (CADR L)) MACRO)

(DEFPROP COLUMN (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q COLLOC) (CDR L)))) MACRO)

(DEFPROP GETVAL (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP HEIGHT (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q HTLOC) (CDR L)))) MACRO)

(DEFPROP HTLOC (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP MOLDCHAR
	 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q CHAR)) (CADR L))))
	 MACRO)

(DEFPROP MOLDEXPR
	 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q EXPR)) (CADR L))))
	 MACRO)

(DEFPROP MOLDLIST
 (LAMBDA (L) (LIST (Q LIST) (LIST (Q MCONS) (Q (Q LIST)) (CADDR L) (CADR L))))
 MACRO)

(DEFPROP MOLDTAB
	 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q TAB)) (CADR L))))
	 MACRO)

(DEFPROP SETCRLF (LAMBDA (L) (LIST (Q SETTAB) (CADR L) 0)) MACRO)

(DEFPROP SETDOT (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *PT))) MACRO)

(DEFPROP SETLPR (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *LP))) MACRO)

(DEFPROP SETRPR (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *RP))) MACRO)

(DEFPROP SETSPC (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *SP))) MACRO)

(DEFPROP SETVAL (LAMBDA (L) (CONS (Q RPLACA) (CDR L))) MACRO)

(DEFPROP TEXT (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q TXTLOC) (CDR L)))) MACRO)

(DEFPROP TXTLOC (LAMBDA (L) (CONS (Q CDDDR) (CDR L))) MACRO)

(DEFPROP WELDTEXT (LAMBDA (L) (LIST (Q NCONC) (CADR L) (CADDR L))) MACRO)

(DEFPROP WIDTH (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q WDTHLOC) (CDR L)))) MACRO)

(DEFPROP WDTHLOC (LAMBDA (L) (CONS (Q CDDR) (CDR L))) MACRO)

(COMMENT END OF FORMAT PROGRAM MACROS)

(DFUNC (ALTERCOL PLATE COL) (PROG2 (SETVAL (COLLOC PLATE) COL) PLATE))

(DFUNC (ALTERHT PLATE HT) (PROG2 (SETVAL (HTLOC PLATE) HT) PLATE))

(DFUNC (ALTERTEXT PLATE TXT) (PROG2 (SETVAL (TXTLOC PLATE) TXT) PLATE))

(DFUNC (ALTERWDTH PLATE WDTH) (PROG2 (SETVAL (WDTHLOC PLATE) WDTH) PLATE))

(DFUNC (CLAP PL ST) (SETCRLF (SETEXPR (SETCRLF PL) ST)))

(DFUNC (COMPOSASSIGN EXPR WIDTH RPARS SLACK)
       (PROG (MARG PLATE REST)
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETQ MARG (ADD1 (COLUMN PLATE)))
	     (SETQ REST	(COMPOSLIST (CDDR EXPR)
				    (DIFFERENCE WIDTH MARG)
				    (ADD1 RPARS)
				    (PLUS SLACK (SUB1 MARG))))
	     (COND ((NOT (GREATERP (FULLWTH REST (ADD1 RPARS))
				   (DIFFERENCE WIDTH MARG)))
		    (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
	     (SETQ MARG (DIFFERENCE MARG (ADD1 (FLATSIZE (CADR EXPR)))))
	     (SETQ REST	(COMPOSLIST (CDDR EXPR)
				    (DIFFERENCE WIDTH MARG)
				    (ADD1 RPARS)
				    (PLUS SLACK (SUB1 MARG))))
	     (COND ((NOT (GREATERP (FULLWTH REST (ADD1 RPARS))
				   (DIFFERENCE WIDTH MARG)))
		    (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
	     (RETURN (SETRPR (SETLIST PLATE
				      1
				      (COMPOSLIST (CDDR EXPR)
						  (SUB1 WIDTH)
						  (ADD1 RPARS)
						  SLACK))))))

(DFUNC (COMPOSATOMS ATOMS WIDTH RPARS SLACK)
       (PROG (PLATE WTH)
	     (SETQ PLATE (CLEANPLATE))
	     (COND ((NOT (NULL ATOMS)) (SETEXPR PLATE (CAR ATOMS))
				       (SETQ ATOMS (CDR ATOMS))))
	LOOP (COND ((NULL ATOMS) (RETURN PLATE)))
	     (SETQ WTH (PLUS (COLUMN PLATE) 1 (FLATSIZE (CAR ATOMS))))
	     (COND ((NULL (CDR ATOMS)) (SETQ WTH (ADD1 WTH))))
	     (COND ((GREATERP WTH WIDTH) (SETCRLF PLATE)) (T (SETSPC PLATE)))
	     (SETEXPR PLATE (CAR ATOMS))
	     (SETQ ATOMS (CDR ATOMS))
	     (GO LOOP)))

(DFUNC (COMPOSDEFS EXPR WIDTH RPARS SLACK)
 (PROG (MARG PLATE REST)
       (SETQ PLATE (CLEANPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADR EXPR))
       (SETQ MARG (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ REST (COMPOSLIST (CDDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((GREATERP (FULLWTH REST (ADD1 RPARS)) (DIFFERENCE WIDTH MARG))
	      (SETQ MARG 1)))
       (RETURN (SETRPR (SETLIST PLATE MARG REST)))))

(DFUNC (COMPOSDE EXPR WIDTH RPARS SLACK)
 (PROG (MARG MARG1 PLATE REST)
       (SETQ PLATE (CLEANPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADDR EXPR))
       (SETQ MARG1 (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ MARG (PLUS MARG1 (FLATSIZE (CADR EXPR)) 1))
       (SETQ REST (COMPOSLIST (CDDDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((GREATERP (FULLWTH REST (ADD1 RPARS)) (DIFFERENCE WIDTH MARG))
	      (SETQ MARG MARG1)))
       (COND ((GREATERP (FULLWTH REST (ADD1 RPARS)) (DIFFERENCE WIDTH MARG))
	      (SETQ MARG 1)))
       (RETURN (SETRPR (SETLIST PLATE MARG REST)))))

(DFUNC (COMPOSEXPR EXPR WIDTH RPARS SLACK)
 (PROG (FIRST MARG PLATE REST TEM)
       (SETQ PLATE (SETEXPR (CLEANPLATE) EXPR))
       (COND ((OR (ATOM EXPR)
		  (NOT (GREATERP (PLUS (COLUMN PLATE) RPARS) WIDTH)))
	      (RETURN PLATE)))
       (COND ((AND (ATOM (CAR EXPR))
		   (NOT (NUMBERP (CAR EXPR)))
		   (SETQ TEM (GETGET (CAR EXPR) (Q EXPRFORM))))
	      (RETURN ((PROPVAL TEM) EXPR WIDTH RPARS SLACK))))
       (SETQ PLATE (SETLPR (CLEANPLATE)))
       (COND ((ATOM (CDR EXPR))
	      (RETURN (SETRPR (SETLIST PLATE
				       1
				       (COMPOSLIST EXPR
						   (SUB1 WIDTH)
						   (ADD1 RPARS)
						   SLACK))))))
       (SETQ FIRST (COMPOSEXPR (CAR EXPR) (SUB1 WIDTH) 0 SLACK))
       (SETQ MARG (PLUS (COLUMN FIRST) 2))
       (COND ((ATOM (CAR EXPR)) (GO ATOM)))
       (SETQ REST (COMPOSLIST (CDR EXPR) (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (COND ((OR (GREATERP (HEIGHT FIRST) 1)
		  (LESSP (DIFFERENCE WIDTH MARG) (FULLWTH REST (ADD1 RPARS))))
	      (RETURN (SETRPR (SETLIST PLATE 1 (SETPLATE FIRST REST))))))
       (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST)))
  ATOM (SETQ REST (COMPOSLIST (CDR EXPR)
			      (DIFFERENCE WIDTH MARG)
			      (ADD1 RPARS)
			      (PLUS SLACK (SUB1 MARG))))
       (COND ((LESSP (PLUS SLACK (DIFFERENCE WIDTH MARG))
		     (FULLWTH REST (ADD1 RPARS)))
	      (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR))
				       1
				       (COMPOSLIST (CDR EXPR)
						   (SUB1 WIDTH)
						   (ADD1 RPARS)
						   SLACK))))))
       (RETURN (SETRPR (SETLIST (SETEXPR PLATE (CAR EXPR)) MARG REST)))))

(DFUNC (COMPOSLAP STATS WIDTH RPARS SLACK)
       (PROG (PLATE TEM)
	     (SETQ PLATE (CLEANPLATE))
	LOOP (COND ((NULL STATS) (RETURN PLATE)))
	     (COND ((NULL (CAR STATS))
		    (SETEXPR (SETTAB (SETCRLF PLATE) LAPINDENT) NIL))
		   ((ATOM (CAR STATS)) (SETEXPR (SETTAB PLATE 1) (CAR STATS)))
		   ((AND (ATOM (CAAR STATS))
			 (NOT (NUMBERP (CAAR STATS)))
			 (SETQ TEM (SEEKPROP (CAAR STATS) (Q LAPFORM))))
		    ((PROPVAL TEM) PLATE (CAR STATS)))
		   (T (SETLIST PLATE
			       LAPINDENT
			       (COMPOSEXPR (CAR STATS)
					   (*DIF WIDTH LAPINDENT)
					   RPARS
					   SLACK))))
	     (SETQ STATS (CDR STATS))
	     (GO LOOP)))

(DFUNC (COMPOSLIST LIST WIDTH RPARS SLACK)
       (PROG (PLATE)
	     (SETQ PLATE (CLEANPLATE))
	LOOP (SETPLATE PLATE
		       (COMPOSEXPR (CAR LIST)
				   WIDTH
				   (COND ((NULL (CDR LIST)) RPARS)
					 ((ATOM (CDR LIST))
					  (PLUS RPARS (FLATSIZE (CDR LIST)) 3))
					 (T 0))
				   SLACK))
	     (SETQ LIST (CDR LIST))
	     (COND ((NULL LIST) (RETURN PLATE)))
	     (COND ((ATOM LIST) (RETURN (SETATOM PLATE LIST))))
	     (GO LOOP)))

(DFUNC (COMPOSMAPDEF EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS MARG PLATE)
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETSPC PLATE)
	     (SETQ MARG (COLUMN PLATE))
	     (SETQ ATOMS (COMPOSATOMS (CDDR EXPR)
				      (DIFFERENCE WIDTH MARG)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE MARG ATOMS)))))

(DFUNC (COMPOSPROG EXPR WIDTH RPARS SLACK)
 (PROG (INDENT PLATE PVARS STATS)
       (SETQ PLATE (CLEANPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
       (SETQ PVARS (COMPOSPVARS	(CADR EXPR)
				(DIFFERENCE WIDTH INDENT)
				(COND ((NULL (CDDR EXPR)) (ADD1 RPARS)) (T 0))
				SLACK))
       (SETLIST PLATE INDENT PVARS)
       (SETQ STATS (CDDR EXPR))
  LOOP (COND ((NULL STATS) (RETURN (SETRPR PLATE))))
       (COND ((ATOM (CAR STATS)) (SETEXPR (SETTAB PLATE 1) (CAR STATS)))
	     (T	(SETLIST PLATE
			 INDENT
			 (COMPOSEXPR (CAR STATS)
				     (DIFFERENCE WIDTH INDENT)
				     (COND ((NULL (CDR STATS)) (ADD1 RPARS))
					   (T 0))
				     SLACK))))
       (SETQ STATS (CDR STATS))
       (GO LOOP)))

(DFUNC (COMPOSPVARS VARS WIDTH RPARS SLACK)
 (PROG (ATOMS PLATE)
       (SETQ PLATE (SETEXPR (CLEANPLATE) VARS))
       (COND ((OR (ATOM VARS)
		  (NOT (GREATERP (COLUMN PLATE) (DIFFERENCE WIDTH RPARS))))
	      (RETURN PLATE)))
       (SETQ ATOMS (COMPOSATOMS VARS (SUB1 WIDTH) (ADD1 RPARS) SLACK))
       (RETURN (SETRPR (SETLIST (SETLPR (CLEANPLATE)) 1 ATOMS)))))

(DFUNC (COMPOSSPECIAL EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS INDENT PLATE)
	     (SETQ PLATE (CLEANPLATE))
	     (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETQ ATOMS (COMPOSATOMS (CDR EXPR)
				      (DIFFERENCE WIDTH INDENT)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE INDENT ATOMS)))))

(DFUNC (CURCOL) (DIFFERENCE (ADD1 (LINELENGTH NIL)) (CHRCT)))

(DEFPROP DATAERR
	 (LAMBDA (L) (PROG NIL (INC NIL T) (OUTC NIL T) (PRINT L)))
	 FEXPR)

(DFUNC (DOSPEC EXPR WIDTH RPARS SLACK)
       ((GET (CAR EXPR) (Q SPECCOMPOS)) EXPR WIDTH RPARS SLACK))

(DFUNC (DOTOPFORM1 EXPR) ((GET (CAR EXPR) (Q TOPFORM1)) EXPR))

(DFUNC (DOFILE DOREADS INFILE OUTFILE)
       (PROG (LINCNT)
	     (SETQ LINCNT 0)
	     (EVAL (MCONS (Q INPUT) (Q INCHAN) INFILE))
	     (EVAL (MCONS (Q OUTPUT) (Q OUTCHAN) OUTFILE))
	     (INC (Q INCHAN) NIL)
	     (OUTC (Q OUTCHAN) NIL)
	     (DOREADS)
	     (OUTC NIL T)
	     (INC NIL T)))

(DFUNC (FLUSHCOMMENT INFILE OUTFILE)
       (PROG (CH XPR)
	     (COND ((NOT (EQ (CAR XPR) (Q COMMENT)))
		    (INC (EVAL (MCONS (Q INPUT) (GENSYM) INFILE)))
		    (RETURN NIL)))
	LOOP (SETQ CH (ERRSET (REACH)))
	     (COND ((ATOM (CAR CH)) (RETURN NIL))
		   ((EQ (CAR CH) (Q *FF)) (RETURN NIL)))
	     (GO LOOP)))

(DFUNC (FORMANEXPR ANEXPR)
       (PLACEONPAGE (COMPOSEXPR ANEXPR (LINELENGTH NIL) 0 0)))

(DEFPROP FORMAT
 (LAMBDA (L)
  (PROG (DEV)
	(SETQ DEV (Q DSK:))
   LOOP	(COND ((NULL L) (RETURN NIL)))
	(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
	(FORMFILE (LIST DEV (CAR L))
		  (LIST	(Q DSK:)
			(CONS (COND ((ATOM (CAR L)) (CAR L)) (T (CAAR L)))
			      OUTEXT)))
	(SETQ L (CDR L))
	(GO LOOP)))
 FEXPR)

(DFUNC (FORMATEXPR NAME PROP FLAG)
       (FORMANEXPR (LIST (Q DEFPROP) NAME PROP FLAG)))

(DFUNC (FORMATFUN NAME)
       (PROG (DONE PLIST PROP)
	     (SETQ PLIST (FIRSTPROP NAME))
	LOOP (COND ((LASTPROP PLIST) (RETURN (REVERSE DONE))))
	     (SETQ PROP (SEEKPROP (PROPFLAG PLIST) (Q PROPFORM)))
	     (COND ((NULL PROP) (GO ELOOP)))
	     (SETQ DONE (CONS (CONS NAME (PROPFLAG PLIST)) DONE))
	     ((PROPVAL PROP) NAME (PROPVAL PLIST) (PROPFLAG PLIST))
	ELOOP(SETQ PLIST (NEXTPROP PLIST))
	     (GO LOOP)))

(DFUNC (FORMATVALUE NAME PROP FLAG)
       (FORMANEXPR (LIST (Q SETQ) NAME (CDR PROP))))

(DFUNC (FORMF) (PROG NIL (PRINC *FF) (SETQ LINCNT 1)))

(DFUNC (FORMATOM EXPR) (FORMANEXPR EXPR))

(DFUNC (FORMLAP CALL)
       (PLACEONPAGE (COMPOSLAP (READLAP CALL) (LINELENGTH NIL) 0 0)))

(DFUNC (FORMFILE INFILE OUTFILE)
       (PROG (LINCNT)
	     (INC (EVAL (MCONS (Q INPUT) (GENSYM) INFILE)))
	     (FLUSHCOMMENT INFILE OUTFILE)
	     (OUTC (EVAL (MCONS (Q OUTPUT) (GENSYM) OUTFILE)))
	     (LINELENGTH PAGEWIDTH)
	     (SETQ LINCNT 1)
	     (FORMREADS)
	     (INC NIL T)
	     (OUTC NIL T)
	     (RETURN NIL)))

(DFUNC (FORMREAD EXPR)
       (PROG (FORM)
	     (COND ((ATOM EXPR) (RETURN (FORMATOM EXPR))))
	     (COND ((AND (ATOM (CAR EXPR))
			 (NOT (NUMBERP (CAR EXPR)))
			 (SETQ FORM (GETGET (CAR EXPR) (Q TOPFORM))))
		    (RETURN ((PROPVAL FORM) EXPR))))
	     (RETURN (FORMANEXPR EXPR))))

(DEFPROP FORMFUNS
 (LAMBDA (NAMES)
	 (PROG (DONE LINCNT)
	       (SETQ LINCNT 1)
	       (LINEF 1)
	  LOOP (COND ((NULL NAMES) (OUTC NIL T) (RETURN DONE)))
	       (COND ((NOT (ATOM (CAR NAMES)))
		      (OUTC (EVAL (CONS (Q OUTPUT) (CAR NAMES))) NIL))
		     (T (SETQ DONE (APPEND DONE (FORMATFUN (CAR NAMES))))))
	       (SETQ NAMES (CDR NAMES))
	       (GO LOOP)))
 FEXPR)

(DFUNC (FORMREADS) (READLOOP (FUNCTION FORMREAD)))

(DFUNC (FULLWTH PLATE RPARS) (MAX (WIDTH PLATE) (PLUS (COLUMN PLATE) RPARS)))

(DFUNC (LINEF NUM)
       (PROG NIL
	     (COND ((LESSP NUM 0) (RETURN NIL)))
	     (SETQ LINCNT (PLUS LINCNT NUM))
	LOOP (COND ((ZEROP NUM) (RETURN NIL)))
	     (TERPRI)
	     (SETQ NUM (SUB1 NUM))
	     (GO LOOP)))

(DFUNC (MAX N M) (COND ((GREATERP N M) N) (T M)))

(DFUNC (PLACEONPAGE PLATE)
       (PROG NIL
	     (COND ((GREATERP (ADD1 (HEIGHT PLATE))
			      (DIFFERENCE PAGEHEIGHT (SUB1 LINCNT)))
		    (COND ((NOT (ATTOP)) (FORMF)))))
	     (PRINTPLATE (TEXT PLATE) 0)
	     (COND ((NOT (ATLEFT)) (LINEF 2)))
	     (RETURN NIL)))

(DFUNC (PRINTPLATE LIST TAB)
       (PROG (COM)
	LOOP (COND ((NULL LIST) (RETURN NIL)))
	     (SETQ COM (CAR LIST))
	     (COND ((EQ (CAR COM) (Q EXPR)) (PRIN1 (CADR COM)))
		   ((EQ (CAR COM) (Q CHAR)) (PRINC (CADR COM)))
		   ((EQ (CAR COM) (Q TAB)) (TABTO (ADD1 (PLUS TAB (CADR COM)))))
		   ((EQ (CAR COM) (Q LIST))
		    (PRINTPLATE (CDDR COM) (PLUS TAB (CADR COM))))
		   (T (DATAERR BADCOPY-PRINTPLATE)))
	     (SETQ LIST (CDR LIST))
	     (GO LOOP)))

(DFUNC (PRINTN CHAR NUM)
       (PROG (NO)
	     (SETQ NO 1)
	LOOP (COND ((LESSP NUM NO) (RETURN NUM)))
	     (PRINC CHAR)
	     (SETQ NO (ADD1 NO))
	     (GO LOOP)))

(DFUNC (READLAP CALL)
       (PROG (CODE STAT)
	     (SETQ CODE (LIST CALL))
	READ (SETQ STAT (ERRSET (READ)))
	     (COND ((NULL STAT) (DATAERR READERR-READLAP)))
	     (COND ((EQ STAT (Q $EOF$)) (DATAERR EOF-READLAP)))
	     (SETQ STAT (CAR STAT))
	     (SETQ CODE (CONS STAT CODE))
	     (COND ((NULL STAT) (RETURN (REVERSE CODE))))
	     (GO READ)))

(DFUNC (READLOOP ACTFUNC)
       (PROG (EXPR)
	LOOP (SETQ EXPR (ERRSET (READ)))
	     (COND ((NULL EXPR) (DATAERR READERR)))
	     (COND ((EQ EXPR (Q $EOF$)) (RETURN NIL)))
	     (ACTFUNC (CAR EXPR))
	     (GO LOOP)))

(DFUNC (SETATOM PLATE ATOM) (SETEXPR (SETSPC (SETDOT (SETSPC PLATE))) ATOM))

(DFUNC (SETCHAR PLATE CHAR)
 (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE (WELDTEXT (TEXT PLATE) (MOLDCHAR CHAR)))
		      (ADD1 (COLUMN PLATE)))
	    (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETEXPR PLATE EXPR)
 (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE (WELDTEXT (TEXT PLATE) (MOLDEXPR EXPR)))
		      (PLUS (COLUMN PLATE) (FLATSIZE EXPR)))
	    (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETLIST PLATE NUM LIST)
 (ALTERCOL (ALTERWDTH (ALTERHT (ALTERTEXT (SETTAB PLATE NUM)
					  (WELDTEXT (TEXT PLATE)
						    (MOLDLIST (TEXT LIST) NUM)))
			       (COND ((LESSP NUM (COLUMN PLATE))
				      (PLUS (HEIGHT PLATE) (HEIGHT LIST)))
				     (T	(SUB1 (PLUS (HEIGHT PLATE)
						    (HEIGHT LIST))))))
		      (MAX (WIDTH PLATE) (PLUS NUM (WIDTH LIST))))
	   (PLUS NUM (COLUMN LIST))))

(DFUNC (SETPLATE PLATE1 PLATE2)
       (ALTERCOL (ALTERHT (ALTERWDTH (ALTERTEXT	(SETCRLF PLATE1)
						(WELDTEXT (TEXT PLATE1)
							  (TEXT PLATE2)))
				     (MAX (WIDTH PLATE1) (WIDTH PLATE2)))
			  (SUB1 (PLUS (HEIGHT PLATE1) (HEIGHT PLATE2))))
		 (COLUMN PLATE2)))

(DFUNC (SETTAB PLATE COL)
 (ALTERCOL (ALTERWDTH (ALTERHT (ALTERTEXT PLATE
					  (COND	((EQ (COLUMN PLATE) COL)
						 (TEXT PLATE))
						(T (WELDTEXT (TEXT PLATE)
							     (MOLDTAB COL)))))
			       (COND ((LESSP COL (COLUMN PLATE))
				      (ADD1 (HEIGHT PLATE)))
				     (T (HEIGHT PLATE))))
		      (MAX (WIDTH PLATE) COL))
	   COL))

(DFUNC (TABTO COL)
 (PROG NIL
       (COND ((GREATERP (CURCOL) COL) (LINEF 1)))
       (PRINTN *TB (DIFFERENCE (LSH (SUB1 COL) -3) (LSH (SUB1 (CURCOL)) -3)))
       (PRINTN *SP (DIFFERENCE COL (CURCOL)))))

(SETQ OUTEXT (QUOTE FMT))

(SETQ PAGEHEIGHT 75)

(SETQ PAGEWIDTH 120)

(SETQ LAPINDENT 10)

(MAPCAR	(FUNCTION (LAMBDA (PAIR)
			  (PROG2 (SET (CAR PAIR) (INTERN (ASCII (CADR PAIR))))
				 (CAR PAIR))))
	(QUOTE ((*SP 40) (*TB 11)
			 (*CR 15)
			 (*LF 12)
			 (*VT 13)
			 (*FF 14)
			 (*CO 54)
			 (*PT 56)
			 (*LP 50)
			 (*RP 51)
			 (*SL 57)
			 (*AM 33)
			 (*AT 100)
			 (*RO 177)
			 (*COLON 72)
			 (*LB 133)
			 (*RB 135))))

(MAPDEF LAPFORM (LAP CLAP))

(MAPDEF EXPRFORM (SPECCOMPOS DOSPEC))

(MAPDEF PROPFORM (EXPR FORMATEXPR) (FEXPR FORMATEXPR) (MACRO FORMATEXPR)
		 (VALUE FORMATVALUE))

(MAPDEF SPECCOMPOS (COMMENT COMPOSSPECIAL) (DE COMPOSDE) (DEFPROP COMPOSDEFS)
		   (DF COMPOSDE) (DFUNC COMPOSDEFS) (DM COMPOSDE)
		   (GETSYM COMPOSMAPDEF) (LABEL COMPOSASSIGN)
		   (LAMBDA COMPOSDEFS) (MAPDEF COMPOSMAPDEF) (PROG COMPOSPROG)
		   (SETQ COMPOSASSIGN) (SPECIAL COMPOSSPECIAL))

(MAPDEF TOPFORM (TOPFORM1 DOTOPFORM1))

(MAPDEF TOPFORM1 (LAP FORMLAP))